{$R-}
{$D+}
(*
	Sony 1500 -- a HyperCard user-defined command to drive a laser disc 
	player.  (Also Sony 1000A or Sony 2000)
	©Apple Computer, Inc. 1987
	All Rights Reserved.

	To compile and link this file using Macintosh Programmer's Workshop
	(HyperXCmd.p and XCmdGlue.inc must be accessible).

	pascal -w Sony1500.p
	link -m ENTRYPOINT -o HyperCommands -rt XCMD=16 -sn Main=Sony1500 ¶
	  Sony1500.p.o "{MPW}"Libraries:interface.o

    then use ResEdit to copy the resulting XCMD from HyperCommands
	and paste it into the Home stack, or your own stack.
	(XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000,
	 =15 PioneerLVP4200, =16 Sony1500)
*)

{$S Sony1500 } 	{ Segment name must be the same as the command name. }

UNIT DummyUnit;

INTERFACE

   USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
	
PROCEDURE EntryPoint(paramPtr: XCmdPtr);
	
IMPLEMENTATION

TYPE Str19 = String[19];
	 Str31 = String[31];

PROCEDURE Sony1500(paramPtr: XCmdPtr);						FORWARD;

   PROCEDURE EntryPoint(paramPtr: XCmdPtr);
   { entry point cannot have local procs, but forward routines can }
   BEGIN
     Sony1500(paramPtr);
   END;

   PROCEDURE Sony1500(paramPtr: XCmdPtr);
   VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
	   tempStr: Str255;
	   refNum: INTEGER;
	   err: INTEGER;
       params: ARRAY[1..32] OF Str19;

     {$I XCmdGlue.inc }
	  
	 PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
	 BEGIN
	   paramPtr^.returnValue := PasToZero(errMsg);
	   EXIT(Sony1500);
	 END;
	 	   
	 PROCEDURE OpenSerial;
	 VAR handShake: SerShk;
		 baudRate: INTEGER;
	 BEGIN
	   baudRate := 9600;
	   { for now, use modem port so we don't mess with AppleTalk }
	   err := FSOpen('.AOUT',0,refNum);
	   IF err = 0 THEN 
	     BEGIN
		   WITH handShake DO
			 BEGIN
			   fXon := 1;
			   fCTS := 1;
			   xon  := CHR(17);
			   xoff := CHR(19);
			   errs := 0;
			   evts := 0;
			   fInx := 0;
			 END;
		   err := SerHShake(refNum,handShake);
		   IF err = 0 THEN 
			 err := Control(refNum,13,@baudRate);
		 END;
	 END;
	 
	 
	 PROCEDURE CloseSerial;
	 BEGIN
	   err := FSClose(refNum);
	 END;
	 
	 FUNCTION Concat(str1, str2, str3: Str31): Str31;
	 VAR result: Str255;
		 resultLen: INTEGER;
		 charNum: INTEGER;
	 BEGIN
	   result := '';
	   resultLen := 0;
	   FOR charNum := 1 TO Length(str1) DO
		 BEGIN
		   resultLen := resultLen + 1;
		   result[resultLen] := str1[charNum];
		 END;
	   FOR charNum := 1 TO Length(str2) DO
		 BEGIN
		   resultLen := resultLen + 1;
		   result[resultLen] := str2[charNum];
		 END;
	   FOR charNum := 1 TO Length(str3) DO
		 BEGIN
		   resultLen := resultLen + 1;
		   result[resultLen] := str3[charNum];
		 END;
	  result[0] := CHR(resultLen);
	  Concat := result;
	 END;
	 
	 
	 
	 PROCEDURE SendCommand(myByte: INTEGER; cmd: Str31);
	 VAR count: LongInt;
	   temp:	Str31;
	 { all commands must have an extra char at end, which we smash with CR }
	 BEGIN
	   temp[1] := CHAR(myByte);
	   temp[0] := CHAR(1);		{length}
	   IF length(cmd) > 0 THEN
	     BEGIN
	      temp := Concat(temp, cmd, '^');
		  temp[length(temp)] := CHAR($40);	{enter, the completion char}
		 END;
	   count := Length(temp);
	   err := FSWrite(refNum, count, Pointer(Ord(@temp)+1));
	 END;
	 
	 PROCEDURE GetMessage;	 
	 VAR paramNum, charNum: INTEGER;
		 msgChar: CHAR;
	 BEGIN
	   { convert params to pascal strings }
	   FOR paramNum := 1 TO paramPtr^.paramCount DO
		 BEGIN
		   tempStr := params[paramNum];
		   ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
		   { force all chars to lower case }
		   FOR charNum := 1 TO Length(tempStr) DO
			 BEGIN
			   msgChar := tempStr[charNum];
			   IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
				 tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
			 END;
		   params[paramNum] := tempStr;
		 END;
	 END;
	 
	   
	 FUNCTION Contains(target: Str255): BOOLEAN;
	 VAR offset: INTEGER;	 
	 
	   FUNCTION Match(which: INTEGER): BOOLEAN;
	   VAR index: INTEGER;
	   BEGIN
		 Match := TRUE;
		 FOR index := 1 TO Length(target) DO
		   IF index > Length(params[which]) THEN 
			 BEGIN
			   Match := FALSE;  { ran off the end }
			   EXIT(Match);
			 END
		   ELSE IF target[index] <> params[which][index] THEN
			 BEGIN
			   Match := FALSE;  { hit a wrong char }
			   EXIT(Match);
			 END;
	   END;
	   
	 BEGIN
	   Contains := FALSE;
	   FOR offset := 1 TO paramPtr^.paramCount DO
		 IF Match(offset) THEN
		   BEGIN
			 Contains := TRUE;
			 EXIT(Contains);
		   END;
	 END;
	 
	 
	 FUNCTION GetInteger: Str255;
	 { get an integer as straight ASCII }
	 VAR which, digitLoc, charVal: INTEGER;
	 BEGIN
	   FOR which := 1 TO paramPtr^.paramCount DO
		 BEGIN
		   charVal := ORD(params[which][1]);
		   IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
		     BEGIN
	           GetInteger := params[which];		{that whole parameter}
		  	   exit(GetInteger);
			 END;
		 END;
	   GetInteger := '';	{ just in case }
	 END;


   BEGIN
	 OpenSerial;
	 IF err <> 0 THEN 
	   BEGIN
	     SysBeep(1);
	     Fail('Could not open serial port');
	   END;
	 
     GetMessage;
	 
	 { set flags }
	 reverseFlag := Contains('rev');
	 offFlag := Contains('off');
	 tillFlag := Contains('till');
	 
	 IF Contains('stop') THEN SendCommand($3F,'')
	 ELSE IF Contains('eject') THEN SendCommand($2A,'')
	 ELSE IF Contains('search') THEN SendCommand($43,GetInteger)
	 ELSE IF Contains('step') THEN
	   BEGIN
		 IF NOT reverseFlag THEN SendCommand($2B,'')	{step fwd}
	     ELSE SendCommand($2C,'')						{step rev}
	   END
	 ELSE IF Contains('play') THEN
	   BEGIN
		 IF NOT tillFlag THEN
		 	BEGIN
				IF NOT reverseFlag THEN SendCommand($3A,'')	{play fwd}
		 		ELSE SendCommand($4A,''); 					{play rev}
			END
		 ELSE SendCommand($44, Concat(GetInteger,'@','01'))	{play till}
	   END
	 ELSE IF Contains('slow') THEN
	   BEGIN
	     IF NOT reverseFlag THEN SendCommand($3C,'')
		   ELSE SendCommand($4C,'')
	   END
	 ELSE IF Contains('fast') THEN
	   BEGIN
	     IF NOT reverseFlag THEN SendCommand($3B,'')
		   ELSE SendCommand($4B,'')
	   END
	 ELSE IF Contains('scan') THEN
	   BEGIN
		 IF NOT reverseFlag THEN SendCommand($3E,'')		{scan fwd}
	     ELSE SendCommand($4E,'')						{scan rev}
	   END
	 ELSE IF Contains('picture') THEN
	   BEGIN
		 IF NOT offFlag THEN SendCommand($27,'')			{picture on}
	     ELSE SendCommand($26,'')							{picture off}
	   END
	 ELSE IF Contains('frame') THEN
	   BEGIN
		 IF NOT offFlag THEN SendCommand($50,'')			{frame on}
	     ELSE SendCommand($51,'')							{frame off}
	   END
	 ELSE IF Contains('sound') THEN 
	   BEGIN
	     IF Contains('1') THEN
		   IF NOT offFlag THEN SendCommand($46,'')			{sound 1 on}
		   ELSE SendCommand($47,'')							{sound 1 off}
		 ELSE IF Contains('2') THEN
		   IF NOT offFlag THEN SendCommand($48,'')			{sound 2 on}
		   ELSE SendCommand($49,'')							{sound 2 off}
	   END
	 ELSE IF Contains('init') THEN SendCommand($62,'')
	 ELSE
	    BEGIN
		  CloseSerial;
		  SysBeep(1); 
		  Fail('Unknown video command');
		END;
	 CloseSerial;
   END;   

END.



